home *** CD-ROM | disk | FTP | other *** search
/ Inter.Net 55-2 / Inter.Net 55-2.iso / Mandrake / mdkinst / usr / lib / perl5 / site_perl / 5.005 / i386-linux / Gtk.pm
Encoding:
Perl POD Document  |  2000-01-12  |  3.5 KB  |  159 lines
  1. package Gtk;
  2.  
  3. require Exporter;
  4. require DynaLoader;
  5. require AutoLoader;
  6.  
  7. use Carp;
  8.  
  9. $VERSION = '0.6123';
  10.  
  11. @ISA = qw(Exporter DynaLoader);
  12. # Items to export into callers namespace by default. Note: do not export
  13. # names by default without a very good reason. Use EXPORT_OK instead.
  14. # Do not simply export all your public functions/methods/constants.
  15. @EXPORT = qw(
  16.     
  17. );
  18. # Other items we are prepared to export if requested
  19. @EXPORT_OK = qw(
  20. );
  21.  
  22. sub AUTOLOAD {
  23.     # This AUTOLOAD is used to 'autoload' constants from the constant()
  24.     # XS function.  If a constant is not found then control is passed
  25.     # to the AUTOLOAD in AutoLoader.
  26.  
  27.     # NOTE: THIS AUTOLOAD FUNCTION IS FLAWED (but is the best we can do for now).
  28.     # Avoid old-style ``&CONST'' usage. Either remove the ``&'' or add ``()''.
  29.     if (@_ > 0) {
  30.     $AutoLoader::AUTOLOAD = $AUTOLOAD;
  31.     goto &AutoLoader::AUTOLOAD;
  32.     }
  33.     local($constname);
  34.     ($constname = $AUTOLOAD) =~ s/.*:://;
  35.     $val = constant($constname, @_ ? $_[0] : 0);
  36.     if ($! != 0) {
  37.     if ($! =~ /Invalid/) {
  38.         $AutoLoader::AUTOLOAD = $AUTOLOAD;
  39.         goto &AutoLoader::AUTOLOAD;
  40.     }
  41.     else {
  42.         ($pack,$file,$line) = caller;
  43.         die "Your vendor has not defined Gtk macro $constname, used at $file line $line.
  44. ";
  45.     }
  46.     }
  47.     eval "sub $AUTOLOAD { $val }";
  48.     goto &$AUTOLOAD;
  49. }
  50.  
  51. bootstrap Gtk;
  52.  
  53. # Preloaded methods go here.
  54.  
  55. @Gtk::Gdk::Bitmap::ISA = qw(Gtk::Gdk::Pixmap);
  56. @Gtk::Gdk::Window::ISA = qw(Gtk::Gdk::Pixmap);
  57.  
  58. $Gtk::_init_package = "Gtk" if not defined $Gtk::_init_package;
  59.  
  60. package Gtk::_LazyLoader;
  61.  
  62. sub isa {
  63.     my($object, $type) = @_;
  64.     my($class);
  65.     $class = ref($object) || $object;
  66.     
  67.     #return 1 if $class eq $type;
  68.  
  69.     foreach (@{$class . "::_ISA"}, @{$class . "::ISA"}) {
  70.         return 1 if $_ eq $type or $_->isa($type);
  71.     }
  72.  
  73.     return 0;
  74. }
  75.         
  76. sub AUTOLOAD { 
  77.     my($method,$object,$class);
  78.     #print "AUTOLOAD = '$AUTOLOAD', ", join(',', map("'$_'", @_)),"\n";
  79.     if ($AUTOLOAD =~ /^.*::/) {
  80.         $method = $';
  81.     }
  82.     $object = shift @_;
  83.     $class = ref($object) || $object;
  84.     #print "1. Method=$method, object=$object, class=$class\n";
  85.  
  86.     if (not @{$class . "::_ISA"}) {
  87.         my(@parents) = @{$class . "::ISA"};
  88.         while (@parents) {
  89.             $class = shift @parents;
  90.             if (@{$class . "::_ISA"}) {
  91.                 last;
  92.             }
  93.             push @parents, @{$class . "::ISA"};
  94.         }
  95.  
  96.     }
  97.  
  98.     @{$class . "::ISA"} = @{$class . "::_ISA"};
  99.     @{$class . "::_ISA"} = ();
  100.     #print "\@$class"."::ISA = (",join(',', @{$class . "::ISA"}),")\n";
  101.  
  102.     #print "2. Method=$method, object=$object, class=$class\n";
  103.     &{$class . "::_bootstrap"}($class);
  104.     $object->$method(@_);
  105. }
  106.   
  107. package Gtk::Object;
  108.  
  109. use Carp;
  110.  
  111. sub AUTOLOAD {
  112.     # This AUTOLOAD is used to automatically perform accessor/mutator functions
  113.     # for Gtk object data members, in lieu of defined functions.
  114.     
  115.     my($result);
  116.    
  117.     eval {
  118.         if (@_ == 2) {
  119.             $_[0]->set($AUTOLOAD, $_[1]);
  120.         } elsif (@_ == 1) {
  121.             $result = $_[0]->get($AUTOLOAD);
  122.         } else {
  123.             die;
  124.         }
  125.         
  126.         # Set up real method, to speed subsequent access
  127.         eval <<"EOT";
  128.         
  129.         sub $AUTOLOAD {
  130.             if (\@_ == 2) {
  131.                 \$_[0]->set('$AUTOLOAD', \$_[1]);
  132.             } elsif (\@_ == 1) {
  133.                 \$_[0]->get('$AUTOLOAD');
  134.             } else {
  135.                 die "Usage: $AUTOLOAD (Object [, new_value])";
  136.             }
  137.         }
  138. EOT
  139.         
  140.     };
  141.     if ($@) {
  142.         if (ref $_[0]) {
  143.             $AUTOLOAD =~ s/^.*:://;
  144.             croak "Can't locate object method \"$AUTOLOAD\" via package \"" . ref($_[0]) . "\"";
  145.         } else {
  146.             croak "Undefined subroutine \&$AUTOLOAD called";
  147.         }
  148.     }
  149.     $result;
  150. }
  151.  
  152. package Gtk;
  153.  
  154. require Gtk::Types;
  155.  
  156. # Autoload methods go after __END__, and are processed by the autosplit program.
  157.  
  158. 1;
  159.